home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic 4 Database How-To / Visual Basic 4 Database - How-to (The Waite Group)(1995).iso / secure32.fr_ / secure32.fr
Text File  |  1995-09-04  |  5KB  |  177 lines
  1. VERSION 4.00
  2. Begin VB.Form Form1 
  3.    BackColor       =   &H00C0C0C0&
  4.    Caption         =   "Connector"
  5.    ClientHeight    =   2340
  6.    ClientLeft      =   690
  7.    ClientTop       =   1425
  8.    ClientWidth     =   4755
  9.    BeginProperty Font 
  10.       name            =   "MS Sans Serif"
  11.       charset         =   0
  12.       weight          =   700
  13.       size            =   8.25
  14.       underline       =   0   'False
  15.       italic          =   0   'False
  16.       strikethrough   =   0   'False
  17.    EndProperty
  18.    Height          =   2745
  19.    Left            =   630
  20.    LinkTopic       =   "Form1"
  21.    ScaleHeight     =   2340
  22.    ScaleWidth      =   4755
  23.    Top             =   1080
  24.    Width           =   4875
  25.    Begin VB.CommandButton cmdClose 
  26.       Cancel          =   -1  'True
  27.       Caption         =   "Cl&ose"
  28.       Height          =   555
  29.       Left            =   2520
  30.       TabIndex        =   5
  31.       Top             =   1380
  32.       Width           =   1455
  33.    End
  34.    Begin VB.CommandButton cmdConnect 
  35.       Caption         =   "&Connect"
  36.       Default         =   -1  'True
  37.       Height          =   555
  38.       Left            =   540
  39.       TabIndex        =   4
  40.       Top             =   1380
  41.       Width           =   1455
  42.    End
  43.    Begin VB.TextBox txtPassword 
  44.       Height          =   285
  45.       Left            =   1980
  46.       TabIndex        =   3
  47.       Top             =   780
  48.       Width           =   1995
  49.    End
  50.    Begin VB.TextBox txtUserName 
  51.       Height          =   285
  52.       Left            =   1980
  53.       TabIndex        =   2
  54.       Top             =   300
  55.       Width           =   1995
  56.    End
  57.    Begin VB.Label Label2 
  58.       AutoSize        =   -1  'True
  59.       BackColor       =   &H00C0C0C0&
  60.       Caption         =   "Password:"
  61.       Height          =   195
  62.       Left            =   720
  63.       TabIndex        =   1
  64.       Top             =   840
  65.       Width           =   885
  66.    End
  67.    Begin VB.Label Label1 
  68.       AutoSize        =   -1  'True
  69.       BackColor       =   &H00C0C0C0&
  70.       Caption         =   "User name:"
  71.       Height          =   195
  72.       Left            =   720
  73.       TabIndex        =   0
  74.       Top             =   360
  75.       Width           =   975
  76.    End
  77. End
  78. Attribute VB_Name = "Form1"
  79. Attribute VB_Creatable = False
  80. Attribute VB_Exposed = False
  81. Option Explicit
  82.  
  83.    
  84.  
  85. Private Sub cmdClose_Click()
  86.     End
  87. End Sub
  88.  
  89.  
  90. Private Sub Form_Load()
  91.     Dim myUser As String, myPass As String
  92.     Dim winDir As String * 128
  93.     Dim dirLen As Integer, sysDBLen As Integer
  94.     Dim sysDB As String * 128
  95.  
  96.     On Error GoTo LoadError
  97.  
  98.       ' Set the user and passwords for initial login.
  99.     myUser = "Admin"
  100.     myPass = "theboss"
  101.     
  102.     ' read VBDBHT.INI to get the name of the system database,
  103.     ' then assign that name to the SystemDB property
  104.     DBEngine.SystemDB = GetSystemDatabase()
  105.  
  106.     ' log in
  107.     DBEngine.DefaultUser = myUser
  108.     DBEngine.DefaultPassword = myPass
  109.     MsgBox "The system database is " & DBEngine.SystemDB, vbInformation
  110.     
  111. Exit Sub
  112. LoadError:
  113.     Dim msg As String
  114.     msg = Err.Description
  115.     MsgBox msg, vbCritical
  116. End
  117. End Sub
  118.  
  119. Private Sub cmdConnect_Click()
  120.     Dim db As Database
  121.     Dim dbName As String
  122.     Dim rs As Recordset
  123.     Dim ws As Workspace
  124.     Dim myUser As String, myPass As String
  125.     
  126.     On Error GoTo ConnectError
  127.     
  128.     ' Verify that we have a user name entered.
  129.     If txtUserName <> "" Then
  130.         myUser = txtUserName
  131.     Else
  132.         Error 32767
  133.     End If
  134.     
  135.     myPass = txtPassword
  136.     
  137.     ' Create a new workspace for this user.
  138.     Set ws = DBEngine.CreateWorkspace("MyWS", myUser, myPass)
  139.     
  140.    ' Get the database name and open the database in the workspace just created.
  141.     dbName = DataPath() & "\CHAPTER.09\ORDERS.MDB"       ' DataPath is a function in READINI.BAS
  142.     Set db = ws.OpenDatabase(dbName)
  143.     
  144.     ' Open a recordset to verify that we have access.
  145.     Set rs = db.OpenRecordset("SELECT * FROM Customers")
  146.     
  147.     ' No error occurred, so we must have connected OK.
  148.     MsgBox "User " & txtUserName & " connected successfully!", vbInformation
  149.     
  150. Exit Sub
  151. ConnectError:
  152.     Dim msg As String
  153.     If Err.Number = 32767 Then
  154.         msg = "You must enter a user name"
  155.     Else
  156.         msg = Err.Description
  157.     End If
  158.     MsgBox msg, vbExclamation
  159. Exit Sub
  160.     
  161. End Sub
  162.  
  163. Private Function GetSystemDatabase() As String
  164.     ' Returns the name of the system directory
  165.     
  166.     Const INI_FILENAME = "VBDBHT.INI"
  167.     Const MAX_PATH = 128
  168.  
  169.     Dim lpReturnedString As String * MAX_PATH
  170.     Dim bytesBack As Integer
  171.     
  172.     bytesBack = GetPrivateProfileString("Options", _
  173.         "SystemDB", "", lpReturnedString, MAX_PATH, INI_FILENAME)
  174.     GetSystemDatabase = IIf(bytesBack > 0, Left$(lpReturnedString, bytesBack), "")
  175.     
  176. End Function
  177.